home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
tag_env
/
tagenv.bas
< prev
next >
Wrap
BASIC Source File
|
1995-09-06
|
7KB
|
246 lines
' TAGENV.BAS
' REQUIRES:
' STRTOK.BAS
' TagString subsystem:
'
' This set of routines provides support for tagged string fields
' in a VB Form or Control Tag property.
'
' The Tag property, under this support, consists of a string
' of keyword=value pairs, delimited by semicolons; for instance,
' the following might be a tag string:
'
' formname=myForm;myname="Thomas A. Dacon";graphsize=large
'
' You delete a string from a tagged string field by setting it
' to a null string, just like the SET command in DOS.
'
' Keywords and contents fields are stored in mixed case, as supplied,
' but searches for keywords are case-insensitive.
' The API:
'
' SetFormTagString <form>, key$, contents$
' GetFormTagString <form>, key$, contents$
'
' SetCtlTagString <control>, key$, contents$
' GetCtlTagString <control>, key$, contents$
'
Function ExtractKey$ (theSubString As String)
'
' Returns the keyword portion of a
' keyword=value string "kkk=vvvvv"
'
Dim i As Integer
Dim theKey As String
i = InStr(theSubString, "=")
If i <> 0 Then
theKey = Left$(theSubString, i - 1)
Else
theKey = ""
End If
ExtractKey$ = theKey
End Function
Function ExtractKeyValue$ (theSubString As String)
'
' Returns the value portion of a
' keyword=value string "kkk=vvvvv"
'
Dim i As Integer
Dim theContents As String
i = InStr(theSubString, "=")
If i <> 0 Then
theContents = Mid$(theSubString, i + 1)
Else
theContents = ""
End If
ExtractKeyValue$ = theContents
End Function
Sub GetCtlTagString (c As Control, key As String, contents As String)
'
' Get the current value of a key=contents field
' in a Control's Tag property. A null string is
' returned if the key is not found.
'
GetTagSubstring (c.Tag), key, contents
End Sub
Sub GetFormTagString (f As Form, key As String, contents As String)
'
' Get the current value of a key=contents field
' in a Form's Tag property. A null string is
' returned if the key is not found.
'
GetTagSubstring (f.Tag), key, contents
End Sub
Sub GetTagSubstring (theTagString As String, key As String, contents As String)
'
' Internal routine to retrieve the contents of a key=contents
' field in a string variable.
'
Dim thisString As String
Dim subString As String
contents = "" 'in case we don't find the key
If theTagString <> "" Then
thisString = theTagString
Do
subString = StrTok$(thisString, ";")
thisString = ""
If subString <> "" Then
If UCase$(ExtractKey$(subString)) = UCase$(key) Then
contents = ExtractKeyValue$(subString)
Exit Do
End If
End If
Loop Until subString = ""
End If
End Sub
Function ParseKeywordValue (text As String, keyword As String, keyvalue As String) As Integer
'
' Given a text string of the form:
' keyword = value
' or keyword = "value"
' parses the keyword and value into the output arguments,
' stripping leading and trailing blanks, and removing the
' optional double quotes from the value field.
'
' Returns Boolean("=" character present, following a non-blank field)
'
Dim eqPos As Integer
Dim quotes As String * 1
eqPos = InStr(text, "=")
If eqPos > 0 Then
keyword = LTrim$(RTrim$(Left$(text, eqPos - 1)))
keyvalue = LTrim$(RTrim$(Mid$(text, eqPos + 1)))
quotes = Chr$(34)
If Left$(keyvalue, 1) = quotes And Right$(keyvalue, 1) = quotes Then
keyvalue = Mid$(keyvalue, 2, Len(keyvalue) - 2)
End If
End If
ParseKeywordValue = (eqPos > 0) And (keyword <> "")
End Function
Sub SetCtlTagString (c As Control, key As String, contents As String)
'
' Insert, replace, or delete a key=contents field
' in a Control's Tag property.
'
Dim theTagString As String
theTagString = c.Tag
SetTagSubstring theTagString, key, contents
c.Tag = theTagString
End Sub
Sub SetFormTagString (f As Form, key As String, contents As String)
'
' Insert, replace, or delete a key=contents field
' in a Form's Tag property.
'
Dim theTagString As String
theTagString = f.Tag
SetTagSubstring theTagString, key, contents
f.Tag = theTagString
End Sub
Sub SetTagSubstring (theTagString As String, key As String, contents As String)
'
' Internal routine to insert, replace, or delete
' a key=contents field in a string variable.
'
Dim tagStringAccumulator As String
Dim thisString As String
Dim subString As String
Dim theKey As String
Dim substringToAdd As String
tagStringAccumulator = ""
If theTagString <> "" Then
thisString = theTagString
foundIt = False
Do
subString = StrTok$(thisString, ";")
thisString = "" 'for subsequent strtok calls
If subString <> "" Then
If Not foundIt Then
theKey = ExtractKey$(subString)
If theKey <> key Then
substringToAdd = subString
GoSub AddSubstring
Else 'this deletes if new contents = ""
foundIt = True
If contents <> "" Then
substringToAdd = key + "=" + contents
GoSub AddSubstring
End If
End If
Else
substringToAdd = subString
GoSub AddSubstring
End If
End If
Loop Until subString = ""
' If we didn't find the key, we need to add the
' substring as a new one (providing there's content).
If Not foundIt Then
If contents <> "" Then
substringToAdd = key + "=" + contents
GoSub AddSubstring
End If
End If
Else 'no current contents in tag string
If contents <> "" Then 'if user supplied contents,
substringToAdd = key + "=" + contents
GoSub AddSubstring
End If
End If
' Return the resulting tag string.
theTagString = tagStringAccumulator
Exit Sub
' Add a substring to the end of the tag string accumulator.
AddSubstring:
If tagStringAccumulator <> "" Then
tagStringAccumulator = tagStringAccumulator + ";"
End If
tagStringAccumulator = tagStringAccumulator + substringToAdd
Return
End Sub